home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Sample Code / Snippets / Printing / PicCommentsTest / TestPicComments.p < prev    next >
Encoding:
Text File  |  1992-07-09  |  17.5 KB  |  636 lines  |  [TEXT/PJMM]
  1. unit TestPicComments;
  2.  
  3. interface
  4.     uses
  5.         FixMath, PrintTraps, PicComments, Globals;
  6.  
  7.     procedure TextRotationDemo;
  8.     procedure LineLayoutDemo;
  9.     procedure PolygonDemo (filled, closed: Boolean);
  10.     procedure DashDemo;
  11.     procedure LineWidthDemo;
  12.     procedure GraphRotDemo;
  13.     procedure PostScriptComments;
  14.  
  15.  
  16. implementation
  17.  
  18.     function RotatePt (p, c: Point; ca, sa: Extended): Point;
  19. { Rotates point p around center c using ca = cos(angle), sa = sin(angle) }
  20. { and returns rotated point as function value. }
  21.         var
  22.             t: Integer;
  23.     begin
  24.         t := p.h - c.h;
  25.         p.h := c.h + Round(ca * t - sa * (p.v - c.v));
  26.         p.v := c.v - Round(-sa * t - ca * (p.v - c.v));
  27.         RotatePt := p;
  28.     end;
  29.  
  30.     procedure QDRotatedRect (r: Rect; ctr: Point; angle: Fixed);
  31.         var
  32.             ca, sa, t: Extended;
  33.             pt, tl, tr, bl, br: Point;
  34.     begin
  35.         t := 3.14159 / 180;  { convert degrees to radians for sin, cos }
  36.         t := t * angle / 65536;  { convert Fixed angle to Extended }
  37.         ca := cos(t);
  38.         sa := -sin(t);  { because of QuickDraw's mathematically negative y-direction }
  39.         PenNormal;
  40.         GetPen(pt);
  41.         AddPt(pt, ctr);
  42.         tl := r.topLeft;
  43.         br := r.botRight;
  44.         SetPt(tr, br.h, tl.v);
  45.         SetPt(bl, tl.h, br.v);
  46.  
  47.         tl := RotatePt(tl, ctr, ca, sa);
  48.         tr := RotatePt(tr, ctr, ca, sa);
  49.         bl := RotatePt(bl, ctr, ca, sa);
  50.         br := RotatePt(br, ctr, ca, sa);
  51.  
  52.         MoveTo(tl.h, tl.v);
  53.         LineTo(tr.h, tr.v);
  54.         LineTo(br.h, br.v);
  55.         LineTo(bl.h, bl.v);
  56.         LineTo(tl.h, tl.v);
  57.  
  58.         MoveTo(pt.h, pt.v);
  59.     end;
  60.  
  61.  
  62.     procedure QDStringRotation (s: Str255; ctr: Point; just, flip: Integer; rot: Fixed);
  63. { QDStringRotation provides a QuickDraw substitute for the PostScript feature. }
  64. { May contain any QuickDraw imaging, except picture comments. }
  65. { Left as an exercise for the reader ... }
  66.         var
  67.             ca, sa, t: Extended;
  68.             info: FontInfo;
  69.             r: Rect;
  70.             pt: Point;
  71.             ts: Str255;
  72.             saveFont, saveSize, x, y: Integer;
  73.     begin
  74.         PenNormal;
  75.         GetPen(pt);
  76.  
  77. {•  DrawString(s);  -- This would show the non-rotated string! •}
  78.  
  79.         GetFontInfo(info);
  80.         SetRect(r, pt.h, pt.v - info.ascent, pt.h + StringWidth(s), pt.v + info.descent);
  81.         QDRotatedRect(r, ctr, rot);
  82.  
  83.         AddPt(pt, ctr);
  84.         SetRect(r, ctr.h - 3, ctr.v - 3, ctr.h + 3, ctr.v + 3);
  85.         FrameOval(r);  { the center of the rotation }
  86.  
  87.         GetIndString(ts, rStrings, iCommentRotate);  { explain the rotated boxes }
  88.         saveFont := thePort^.txFont;
  89.         saveSize := thePort^.txSize;
  90.         TextFont(applFont);
  91.         TextSize(12);
  92.         with thePort^.portRect do
  93.             begin
  94.                 x := left + ((right - left - StringWidth(ts))) div 2;
  95.                 y := bottom - 20;
  96.             end;
  97.         MoveTo(x, y);
  98.         DrawString(ts);
  99.         TextFont(saveFont);
  100.         TextSize(saveSize);
  101.         MoveTo(pt.h, pt.v); { preserve pen location }
  102.     end;
  103.  
  104.     procedure DrawXString (s: Str255; ctr: Point; just, flip: Integer; rot: Fixed);
  105. { Draws the string s rotated by rot degrees around the current point, offset  }
  106. { by ctr, justifying and flipping according to the just and flip parameters.  }
  107. { If printed to a PostScript device, the rotation is done by the PostScript   }
  108. { interpreter; if the printer driver does not recognize the PostScriptBegin   }
  109. { and PostScriptEnd picture comments, the external procedure QDStringRotation }
  110. { is used to image the rotated string. The pen position is preserved.         }
  111.  
  112.         var
  113.             hT: TTxtPicHdl;     { defined in PicComments.p - see Appendix }
  114.             hC: TCenterHdl;  { –"– }
  115.             zeroRect: Rect;
  116.             pt: Point;
  117.             oldClip: RgnHandle;
  118.  
  119.     begin
  120.         GetPen(pt);  { to preserve the pen position }
  121.  
  122.       { This is for non-PostScript printers: }
  123.       { ------------------------------------ }
  124.         PicComment(PostScriptBegin, 0, nil);
  125.         QDStringRotation(s, ctr, just, flip, rot);
  126.         PicComment(PostScriptEnd, 0, nil);
  127.  
  128.       { The following is for PostScript printers only: }
  129.       { ---------------------------------------------- }
  130.  
  131. {•  QDStringRotation(s, ctr, just, flip, rot); •}
  132. { This may be useful to demonstrate the effects of just/flip }
  133.  
  134.  
  135.         hT := TTxtPicHdl(NewHandle(SizeOf(TTxtPicRec)));
  136.         hC := TCenterHdl(NewHandle(SizeOf(TCenterRec)));
  137.       { no error handling: if these fail, we are in deep trouble anyway ...}
  138.  
  139.         hT^^.tJus := just;
  140.         hT^^.tFlip := flip;
  141.         hT^^.tAngle := -FixRound(rot); { I like counter-clockwise better }
  142.         hT^^.tLine := 0; { reserved }
  143.         hT^^.tCmnt := 0; { used internally by the printer driver }
  144.         hT^^.tAngleFixed := -rot;
  145.  
  146.         hC^^.y := Long2Fix(ctr.v);
  147.         hC^^.x := Long2Fix(ctr.h);
  148.  
  149.         PicComment(TextBegin, SizeOf(TTxtPicRec), Handle(hT));
  150.         PicComment(TextCenter, SizeOf(TCenterRec), Handle(hC));
  151.       { PostScript graphics state now has rotated/flipped coordinates }
  152.  
  153.       { Hide the following DrawString from QuickDraw }
  154.         oldClip := NewRgn;
  155.         GetClip(oldClip);
  156.         SetRect(zeroRect, 0, 0, 0, 0);
  157.         ClipRect(zeroRect);
  158.       { The PostScript driver ignores clipping between TextBegin and TextEnd  }
  159.         DrawString(s); { in the rotated PostScript environment }
  160.         ClipRect(oldClip^^.rgnBBox);
  161.  
  162.         PicComment(TextEnd, 0, nil);
  163.       { Set PostScript's environment back to the original state }
  164.  
  165.         DisposHandle(Handle(hT));
  166.         DisposHandle(Handle(hC));
  167.  
  168.         MoveTo(pt.h, pt.v);  { to preserve the pen position }
  169.     end;
  170.  
  171.     procedure TextRotationDemo;
  172.         const
  173.             x0 = 140;
  174.             y0 = 140;
  175.             fontSize = 36;
  176.         var
  177.             ctr: Point;
  178.             familyID: Integer;
  179.             angle: Fixed;
  180.             fontName, s: Str255;
  181.     begin
  182.         GetIndString(fontName, rFontNames, iTextRotFont);
  183.         GetFNum(fontName, familyID);
  184.         TextFont(familyID);
  185.         TextSize(fontSize);
  186.         TextFace([]);
  187.         GetIndString(s, rStrings, iRotatedText);
  188.         ctr.v := 0;
  189.         ctr.h := StringWidth(s) div 2;
  190.         MoveTo(x0, y0);
  191.         angle := Long2Fix(45);
  192.         DrawXString(s, ctr, gJus, gFlip, angle);
  193.         angle := Long2Fix(-30);
  194.         DrawXString(s, ctr, gJus, gFlip, angle);
  195.     end;
  196.  
  197. {-------------------------------------------------------------------------------}
  198.     procedure LineLayoutDemo;
  199.         const
  200.             fontSize = 14;
  201.             x0 = 20; { starting point }
  202.             y0 = 40;
  203.             h = 30; { line height }
  204.         var
  205.             familyID: Integer;
  206.             w, y: Integer;
  207.             fontName, s1, s2: Str255;
  208.  
  209.         procedure DrawSpacedCharacters (vPos: Integer; addStrCmt: Boolean);
  210.             const
  211.                 firstChar = 'a';
  212.                 lastChar = 'z';
  213.                 d = 12;
  214.             var
  215.                 i: Integer;
  216.         begin
  217.             MoveTo(x0, vPos);
  218.             for i := 0 to ord(lastChar) - ord(firstChar) do
  219.                 begin
  220.                     if addStrCmt then
  221.                         PicComment(StringBegin, 0, nil);
  222.                     MoveTo(x0 + i * d, vPos);
  223.                     DrawChar(chr(ord(firstChar) + i));
  224.                     if addStrCmt then
  225.                         PicComment(StringEnd, 0, nil);
  226.                 end;
  227.             for i := 0 to ord(lastChar) - ord(firstChar) do
  228.                 begin
  229.                     MoveTo(x0 + i * d, vPos + 4);
  230.                     Line(0, 3);
  231.                 end;
  232.         end; { DrawSpacedCharacters }
  233.  
  234.     begin { LineLayoutDemo }
  235.         GetIndString(fontName, rFontNames, iLLFont1);
  236.         GetIndString(s1, rStrings, iLineLayout1);
  237.         GetIndString(s2, rStrings, iLineLayout2);
  238.         GetFNum(fontName, familyID);
  239.         TextFont(familyID);
  240.         TextSize(fontSize);
  241.         w := StringWidth(s1);
  242.         y := y0;
  243.         MoveTo(x0 + w, y - h);
  244.         Line(0, 9 * h div 2);  { this is to estimate the difference }
  245.  
  246.         MoveTo(x0, y);
  247.         DrawString(s1);
  248.         MoveTo(x0 + w, y);
  249.         DrawString(s2);
  250.         y := y + h;
  251.  
  252.         PicComment(LineLayoutOff, 0, nil);
  253.  
  254.         MoveTo(x0, y);
  255.         DrawString(s1);
  256.         MoveTo(x0 + w, y);
  257.         DrawString(s2);
  258.         y := y + h;
  259.  
  260.         PicComment(StringBegin, 0, nil);  { see comment in TN #91 ! }
  261.         MoveTo(x0, y);
  262.         DrawString(s1);
  263.         PicComment(StringEnd, 0, nil);
  264.  
  265.         MoveTo(x0 + w, y);
  266.         DrawString(s2);
  267.         y := y + h;
  268.  
  269.         PicComment(LineLayoutOn, 0, nil);
  270.         MoveTo(x0, y);
  271.         DrawString(s1);
  272.         MoveTo(x0 + w, y);
  273.         DrawString(s2);
  274.         y := y + 3 * h div 2;
  275.  
  276.         GetIndString(fontName, rFontNames, iLLFont2);
  277.         GetFNum(fontName, familyID);
  278.         TextFont(familyID);
  279.  
  280.         DrawSpacedCharacters(y, FALSE);
  281.         y := y + h;
  282.         PicComment(LineLayoutOff, 0, nil);
  283.         DrawSpacedCharacters(y, FALSE);
  284.         y := y + h;
  285.         DrawSpacedCharacters(y, TRUE);  { StringBegin/StringEnd with each character }
  286.         PicComment(LineLayoutOn, 0, nil);  { restore default }
  287.     end; { LineLayoutDemo }
  288.  
  289. {-------------------------------------------------------------------------------}
  290.     procedure PolygonDemo (filled, closed: Boolean);
  291.         const
  292.             kN = 4; { number of vertices for PostScript}
  293.             kA = 6; { " for QD approximation of smoothed "not closed" polygon }
  294.             kB = 8; { " for QD approximation of smoothed "closed" polygon }
  295.         type
  296.             PointArray = array[0..0] of Point;  { Range checking OFF }
  297.             PointArrayPtr = ^PointArray;
  298.         var
  299.             p, qa, qb: PointArrayPtr;
  300.             aPolyVerbH: TPolyVerbHdl;
  301.             i: Integer;
  302.             clipRgn, polyRgn: RgnHandle;
  303.             zeroRect: Rect;
  304.  
  305.         procedure DefineVertices (p, qa, qb: PointArrayPtr);
  306.             const
  307.                 cx = 240;
  308.                 cy = 150;
  309.                 r0 = 130;
  310.             var
  311.                 d, i: Integer;
  312.         begin
  313.    { The array p^ contains the array of the control points for the Bézier curve: }
  314.             SetPt(p^[0], cx + r0, cy);
  315.             SetPt(p^[1], cx, cy + r0);
  316.             SetPt(p^[2], cx - r0, cy);
  317.             SetPt(p^[3], cx, cy - r0);
  318.             p^[4] := p^[0];
  319.             d := round(0.7 * (p^[1].v - cy));
  320.  
  321.             qa^[0] := p^[0];
  322.    { qa^ contains the points for a crude polygon approximation of the  }
  323.    { smoothed curve, with "closed" = FALSE }
  324.             SetPt(qa^[1], cx, cy + d);
  325.             SetPt(qa^[2], (p^[1].h + p^[2].h) div 2, (p^[1].v + p^[2].v) div 2);
  326.             SetPt(qa^[3], cx + round(0.8 * (p^[2].h - cx)), cy);
  327.             SetPt(qa^[4], qa^[2].h, cy + cy - qa^[2].v);
  328.             SetPt(qa^[5], qa^[1].h, cy + cy - qa^[1].v);
  329.             qa^[6] := qa^[0];
  330.    { qb^ contains the points for a crude polygon approximation of the  }
  331.    { smoothed curve, with "closed" = TRUE }
  332.             SetPt(qb^[0], cx + d, cy);
  333.             SetPt(qb^[2], cx, cy + d);
  334.             SetPt(qb^[4], cx - d, cy);
  335.             SetPt(qb^[6], cx, cy - d);
  336.             for i := 0 to 3 do
  337.                 SetPt(qb^[2 * i + 1], (p^[i].h + p^[i + 1].h) div 2, (p^[i].v + p^[i + 1].v) div 2);
  338.             qb^[8] := qb^[0];
  339.         end;  { DefineVertices}
  340.  
  341.     begin  { PolygonDemo }
  342.         p := PointArrayPtr(NewPtr(SizeOf(Point) * (kN + 1)));
  343.         qa := PointArrayPtr(NewPtr(SizeOf(Point) * (kA + 1)));
  344.         qb := PointArrayPtr(NewPtr(SizeOf(Point) * (kB + 1)));
  345.         if (p = nil) or (qa = nil) or (qb = nil) then
  346.             DebugStr('NewPtr failed');
  347.         DefineVertices(p, qa, qb);
  348.  
  349.         PenNormal;              { First show the standard QuickDraw polygon }
  350.         MoveTo(p^[0].h, p^[0].v);
  351.         for i := 1 to kN do
  352.             LineTo(p^[i].h, p^[i].v);
  353.  
  354.         PenSize(2, 2);                     { Now the same polygon "smoothed" }
  355.         PenPat(gray);
  356.       { First, the PostScript representation, clipped off from QuickDraw: }
  357.         aPolyVerbH := TPolyVerbHdl(NewHandle(SizeOf(TPolyVerbRec)));
  358.         if aPolyVerbH <> nil then
  359.             with aPolyVerbH^^ do
  360.                 begin
  361.                     fPolyClose := closed;
  362.                     fPolyFrame := TRUE;
  363.                     fPolyFill := filled;
  364.                     f3 := FALSE;
  365.                     f4 := FALSE;
  366.                     f5 := FALSE;
  367.                     f6 := FALSE;
  368.                     f7 := FALSE;
  369.                 end;
  370.         MoveTo(p^[0].h, p^[0].v);
  371.         PicComment(PolyBegin, 0, nil);
  372.         if closed then
  373.             PicComment(PolyClose, 0, nil);
  374.         PicComment(PolySmooth, SizeOf(TPolyVerbRec), Handle(aPolyVerbH));
  375.         clipRgn := NewRgn;
  376.         GetClip(clipRgn);
  377.         ClipRect(zeroRect);
  378.         for i := 1 to kN do
  379.             LineTo(p^[i].h, p^[i].v);
  380.  
  381.       { Next, the -crude- QuickDraw approximation of the smoothed polygon, }
  382.       { invisible for PostScript because of PolyIgnore: }
  383.         SetClip(clipRgn);
  384.         PicComment(PolyIgnore, 0, nil);
  385.         polyRgn := NewRgn;
  386.         OpenRgn;
  387.         if not closed then
  388.             begin
  389.                 MoveTo(qa^[0].h, qa^[0].v);
  390.                 for i := 1 to kA do
  391.                     LineTo(qa^[i].h, qa^[i].v);
  392.             end
  393.         else
  394.             begin
  395.                 MoveTo(qb^[0].h, qb^[0].v);
  396.                 for i := 1 to kB do
  397.                     LineTo(qb^[i].h, qb^[i].v);
  398.             end;
  399.         CloseRgn(polyRgn);
  400.         FrameRgn(polyRgn);
  401.  
  402.         if filled then
  403.             FillRgn(polyRgn, gray);
  404.  
  405.         PicComment(PolyEnd, 0, nil);
  406.  
  407.         DisposHandle(Handle(aPolyVerbH));
  408.         DisposeRgn(polyRgn);
  409.         DisposPtr(Ptr(p));
  410.         DisposPtr(Ptr(qa));
  411.         DisposPtr(Ptr(qb));
  412.     end;   { PolygonDemo }
  413.  
  414.  
  415.     procedure DashDemo;
  416.         const
  417.             cx = 250;
  418.             cy = 240;
  419.             r0 = 200;
  420.  
  421.         var
  422.             dashHdl: TDashedLineHdl;
  423.             i: Integer;
  424.             a, rad: Extended;
  425.  
  426.         procedure DashedQDLine (dx, dy: Integer; dashSpec: TDashedLineHdl);
  427.             var
  428.                 oldPat: Pattern;
  429.         begin
  430.             oldPat := thePort^.pnPat;
  431.             PenPat(gray);
  432.             Line(dx, dy);
  433.             PenPat(oldPat);
  434.         end;
  435.  
  436.     begin
  437.         PenSize(3, 3);
  438.       { First the PostScript picture comment version.  }
  439.       { The "magic pen mode" 23 makes the line drawing invisible for QuickDraw. }
  440.         PenMode(magicPen);
  441.         dashHdl := TDashedLineHdl(NewHandle(SizeOf(TDashedLineRec)));
  442.         if dashHdl <> nil then
  443.             with dashHdl^^ do
  444.                 begin
  445.                     offset := 2;    { just for fun}
  446.                     centered := 0;  { currently ignored - set to 0 }
  447.                     intervals[0] := 2;
  448.                     intervals[1] := 4;
  449.                     intervals[2] := 8; { this means 4 points on, 8 points off }
  450.                 end;
  451.         PicComment(DashedLine, SizeOf(TDashedLineRec), Handle(dashHdl));
  452.         rad := 3.14159 / 180;    { conversion degrees -> radians }
  453.         for i := 0 to 9 do
  454.             begin { draw some dashed lines }
  455.                 a := i * 20 * rad;
  456.                 MoveTo(cx, cy);
  457.                 Line(round(r0 * cos(a)), -round(r0 * sin(a)));
  458.             end;
  459.         PicComment(DashedStop, 0, nil); { That's enough! }
  460.         DisposHandle(Handle(dashHdl));
  461.         PenMode(srcOr);  { No magic any more. }
  462.  
  463.       { Now, the QuickDraw version. The PostScript driver must ignore it, }
  464.       { so we enclose it between PostScriptBegin and PostScriptEnd comments.}
  465.         PicComment(PostScriptBegin, 0, nil);
  466.         for i := 0 to 9 do
  467.             begin
  468.                 MoveTo(cx, cy);
  469.                 DashedQDLine(round(r0 * cos(i * 20 * rad)), -round(r0 * sin(i * 20 * rad)), dashHdl);
  470.             end;
  471.         PicComment(PostScriptEnd, 0, nil);
  472.     end;
  473.  
  474.  
  475.     procedure SetNewLineWidth (oldWidth, newWidth: TLineWidth);
  476.         var
  477.             tempWidthH: TLineWidthHdl;
  478.     begin
  479.         tempWidthH := TLineWidthHdl(NewHandle(SizeOf(TLineWidth)));
  480.       { If tempWidthH = NIL we are screwed anyway }
  481.         tempWidthH^^.v := oldWidth.h;
  482.         tempWidthH^^.h := oldWidth.v;
  483.         PicComment(SetLineWidth, SizeOf(TLineWidth), Handle(tempWidthH));
  484.         tempWidthH^^ := newWidth;
  485.         PicComment(SetLineWidth, SizeOf(TLineWidth), Handle(tempWidthH));
  486.         DisposHandle(Handle(tempWidthH));
  487.     end;
  488.  
  489.  
  490.     procedure LineWidthDemo;
  491.         const
  492.             y0 = 50;  { topleft of demo }
  493.             x0 = 50;
  494.             d0 = 400; { length of horizontal lines }
  495.             e0 = 5;   { distance between lines }
  496.             kN = 15;  { number of lines }
  497.         var
  498.             oldWidth, newWidth: TLineWidth;  { actuall a "Point" }
  499.             i, j, y: Integer;
  500.     begin
  501.         PenNormal;
  502.         y := y0;
  503.         SetPt(oldWidth, 1, 1);             { initial linewidth = 1.0 }
  504.         for i := 1 to kN do
  505.             begin
  506.                 SetPt(newWidth, 4, i);
  507.                   { want to set it to i/4 = 0.25, 0.50, 0.75 ... }
  508.                 SetNewLineWidth(oldWidth, newWidth);
  509.                 MoveTo(x0, y);
  510.                 Line(d0, 0);
  511.                 y := y + e0;
  512.                 oldWidth := newWidth;
  513.             end;
  514.     end;
  515.  
  516.  
  517.     procedure PSRotatedRect (r: Rect; offset: Point; angle: Fixed);
  518. { Does the rectangle rotation for the PostScript LaserWriter driver. }
  519. { Uses the RotateCenter, RotateBegin and RotateEnd picture comments, }
  520. { and the "magic" pen mode 23 to hide the drawing from QuickDraw.    }
  521.         var
  522.             rInfo: TRotationHdl;
  523.             rCenter: TCenterHdl;
  524.             oldPenMode: Integer;
  525.     begin
  526.         rInfo := TRotationHdl(NewHandle(SizeOf(TRotationRec)));
  527.         rCenter := TCenterHdl(NewHandle(SizeOf(TCenterRec)));
  528.         if (rInfo = nil) or (rCenter = nil) then
  529.             DebugStr('NewHandle failed');
  530.         with rInfo^^ do
  531.             begin
  532.                 rFlip := 0;
  533.                 rAngle := -FixRound(angle);
  534.                 rAngleFixed := -angle;
  535.             end;
  536.         with rCenter^^ do
  537.             begin
  538.                 x := Long2Fix(offset.h);
  539.                 y := Long2Fix(offset.v);
  540.             end;
  541.         MoveTo(r.left, r.top);
  542.         FlushGrafPortState;
  543.         PicComment(RotateCenter, SizeOf(TCenterRec), Handle(rCenter));
  544.         PicComment(RotateBegin, SizeOf(TRotationRec), Handle(rInfo));
  545.         oldPenMode := thePort^.pnMode;
  546.         PenMode(magicPen);
  547.         FrameRect(r);
  548.         PenMode(oldPenMode);
  549.         PicComment(RotateEnd, 0, nil);
  550.         DisposeHandle(Handle(rInfo));
  551.         DisposeHandle(Handle(rCenter));
  552.     end;
  553.  
  554.     procedure GraphRotDemo;
  555.         const
  556.             angle = 30;
  557.         var
  558.             spinRect: Rect;
  559.             delta: Point;
  560.     begin
  561.         SetRect(spinRect, 100, 100, 300, 200);
  562.         with spinRect do
  563.             SetPt(delta, (right - left) div 2, (bottom - top) div 2);
  564.  
  565.         PenSize(2, 2);
  566.         PenPat(ltGray);
  567.         FrameRect(spinRect); { show the unrotated square }
  568.         PenNormal;
  569.  
  570.         PSRotatedRect(spinRect, delta, Long2Fix(angle));
  571.  
  572.  { QuickDraw equivalent of the rotated object, hidden from PostScript driver  }
  573.       { because of PostScriptBegin and PostScriptEnd }
  574.         PicComment(PostScriptBegin, 0, nil);
  575.         QDRotatedRect(spinRect, delta, Long2Fix(angle));
  576.         PicComment(PostScriptEnd, 0, nil);
  577.     end;
  578.  
  579.  
  580.     procedure PostScriptLine (s: Str255);
  581. { A utility procedure to transmit a string of PostScript code through }
  582. { the PostScriptHandle picture comment to the PostScript printer.     }
  583. { It should be called only between PostScriptBegin and PostScriptEnd  }
  584. { picture comments. }
  585.  
  586.         var
  587.             h: Handle;
  588.  
  589.     begin
  590.         h := NewHandle(256);
  591.         if h = nil then
  592.             DebugStr('NewHandle failed');
  593.         BlockMove(@s[1], h^, Length(s));
  594.         PicComment(PostScriptHandle, Length(s), h);
  595.         h^^ := 13;
  596.         PicComment(PostScriptHandle, 1, h); { add a carriage return }
  597.         DisposeHandle(h);
  598.     end;
  599.  
  600.  
  601.     procedure PostScriptComments;
  602.     begin
  603.       { First, the simple example: }
  604.         PicComment(PostScriptBegin, 0, nil);
  605.         PostScriptLine('100 100 moveto 0 100 rlineto 100 0 rlineto ');
  606.         PostScriptLine('0 -100 rlineto -100 0 rlineto');
  607.         PostScriptLine('stroke');
  608.  
  609.         TextFont(applFont);
  610.         TextSize(12);
  611.         MoveTo(30, 30);
  612.         DrawString('This text does not appear on PostScript devices');
  613.         PicComment(PostScriptEnd, 0, nil);
  614.  
  615.       { Now, a new PostScript definition you want to keep in the     }
  616.       { userdict. If you used PostScriptBegin, the definition would  }
  617.       { be lost when PostScriptEnd is encountered, because the state }
  618.       { previous to the PostScriptBegin comment would be restored.   }
  619.         PicComment(PSBeginNoSave, 0, nil);
  620.         PostScriptLine('userdict begin');
  621.         PostScriptLine('/myFrameRect {');
  622.         PostScriptLine('250 250 moveto 0 100 rlineto');
  623.         PostScriptLine('200 0 rlineto 0 -100 rlineto -200 0 rlineto ');
  624.         PostScriptLine('stroke } def');
  625.         PostScriptLine('end');
  626.         PicComment(PostScriptEnd, 0, nil);
  627.  
  628.       { Let's test if the definition from above is still available.  }
  629.       { This assumes that no font downloading has occurred.          }
  630.  
  631.         PicComment(PostScriptBegin, 0, nil);
  632.         PostScriptLine('//userdict /myFrameRect get exec ');
  633.         PicComment(PostScriptEnd, 0, nil);
  634.     end;
  635.  
  636. end.